package SerialLibs::Denon;
$SerialLibs::Denon::VERSION = '0.02';

################################################################################
#
#	Heavily based upon RFLibs::Aquos which was:
#       Created by Ronald Frazier
#       http://www.ronfrazier.net
#
#	Modified by Wayne Thomas to control Denon AVR equipment instead of Sharp
# 	Aquos TV equipment.
#       Feel free to do anything you want with this, as long as you
#       include the above attribution.
#
#	The Denon AVR-3805 that this was developed for has 3 seperate audio
#	outputs (Main Zone, Zone 1, Zone 2).  Zone 1 and Zone 2 can be
#	configured for either to be amplified (the other will be a pre-amp
#	output), or one of the zones can be used to provide 7.1 speaker output
#	in combination with the Main Zone.
#	I have chosen to write this module to control the Main Zone and Zone 1
#	(as an amplified output), and have not provided any control for Zone 2.
#	To use this module as-is you will need to ensure your amp is set up
#	appropriately.
#	The responses from the Main Zone and Zone 1 are identical (i.e. AMP ON) 
#	as it is assumed that the caller knows which Zone is responding due to  
#	the specific command that was sent.
#	
#	Todo:	Tidy up code
#		Make Zone work:
#			When zone power or input are queried it returns input,
#			volume, and power status (in that order, regardless of
#			power status).  Power and Input can be altered with
#			power on or off, Volume can only be altered with power
#			on.
#
################################################################################

use strict;
use Device::SerialPort;
use Time::HiRes qw(sleep);
use List::Util qw(first);

my %debuglevels = ('NONE' => 0, 'ERROR' => 1 , 'WARN' => 2, 'INFO' => 3);
my @inputs = ('PHONO', 'CD', 'TUNER', 'DVD', 'VDP', 'TV', 'DBS/SAT', 'VCR-1', 'VCR-2', 'V.AUX', 'CDR/TAPE1');

sub new
{
        my ($classtype, $serialport_device) = @_;

        my $self = {};
        bless $self, $classtype;

        return $self->init($serialport_device);
};

sub init
{
	my ($self, $serialport_device) = @_;

	my $port = Device::SerialPort->new($serialport_device) or return 0;
	$port->baudrate(9600);
	$port->parity("none");
	$port->databits(8);
	$port->stopbits(1); 
	$port->handshake("none");
	$self->{port} = $port;

	$self->debug('WARN');

	return $self;
};

sub kill
{
        my ($self) = @_;

        return $self->{port}->close;
};

sub debug
{
	my ($self, $debug) = @_;
	$self->{debug} = $debug if defined($debug);
	return $self->{debug};
};

sub debugprint
{
	my ($self, $level, @msg) = @_;
	return if $debuglevels{$self->{debug}} < $debuglevels{$level};
	print STDERR @msg;
};

sub power
{
	my ($self, $value, $zone) = @_;
	$self->debugprint('INFO', "$zone\n");
        my $cmd = ( $zone == 1 ? 'Z1' : 'ZM');
	$value = ($value == 1 ? 'ON' : 'OFF') if $value ne '';
	$cmd = $cmd."PWR" if ($cmd eq 'Z1' && $value eq '');
	my $result = $self->getset($cmd, $value);
	$result =~ s/ZM/AMP /;
	$result =~ s/Z1/AMP /;
	return $result;
};

sub volume
{
	my ($self, $value, $zone) = @_;
        my $cmd = ( $zone == 1 ? 'Z1' : 'MV');
	return 'ERR' if ($value > 92 || $value < 0);
	$cmd = $cmd .'0' if ($value ne '' && $value < 10);
	$cmd = $cmd .'VOL' if ($cmd eq 'Z1' && $value eq '');
	my $current = $self->getset($cmd, $value);
	return $current if $current eq 'ERR';
	$current = substr($current, 2, 2);
	$current = '00' if $current eq '99';
        return "VOLUME $current";
};

sub adjust_volume
{
	my ($self, $adjust, $zone) = @_;
        $self->debugprint('INFO', "Adjust Volume Function\n");
	my $cmd = ( $zone == 1 ? 'Z1' : 'MV');
	my $current;
	if ($cmd eq 'Z1')
	{
		$current = $self->get($cmd.'VOL');	
	}
	else
	{
		$current = $self->get($cmd) if $cmd eq 'MV';
	};
	return $current if $current eq 'ERR';
        $self->debugprint('INFO', "Current Volume = $current\n");
        $current = substr($current, 2, 2);
	$current = '00' if ($current eq '99' && $cmd eq 'MV');
	$current = '10' if ($current eq '99' && $cmd eq 'Z1');
	my $new = $current + ($adjust*5);
	$new = 92 if ($new > 92);
        $new = 0 if ($new < 0);
	$new = 10 if ($new < 10 && $cmd eq 'Z1');
	$cmd = $cmd.'0' if $new < 10;
	$current = $self->getset($cmd, $new);
	return $current if $current eq 'ERR';
	$current = substr($current, 2, 2);
	$current = '00' if $current eq '99';
	return "VOLUME $current";
};

sub mute
{
	my ($self, $value, $zone) = @_;
        my $cmd = ( $zone == 1 ? 'Z1' : 'MU');
        $value = ($value == 1 ? 'ON' : 'OFF') if ($value ne '' && !$zone);
        $value = ($value == 1 ? 'OFF' : 'ON') if ($value ne '' && $zone);
	$cmd = $cmd.'PWR' if ($cmd eq 'Z1' && $value eq '');
	my $result = $self->getset($cmd, $value);
	return $result if $result eq 'ERR';
	$result = substr($result, 2, 3);
	$result = ($result eq 'OFF' ? 'ON' : 'OFF') if $cmd =~ /Z1/;
	return "MUTE $result";
};

sub toggle_mute
{
	my ($self, $zone) = @_;
	my $current;
	if (!$zone)
	{
		$current = $self->get('MU');
		my $result = 0;
	        return 'ERR' if $current eq 'ERR';
		my $volume = $self->get('MV');
		$volume = substr($volume, 2, 2);
		if ($current =~ /OFF/)
		{
			$result = $self->getset('MU', 'ON');
		}
		else
		{
			$result = $self->getset('MU', 'OFF');
		};
		return $result if $result eq 'ERR';
		$result = substr($result, 2, 3);
		return "MUTE $result";
	}
	else
	{
                $current = $self->get('Z1PWR');
		return $current if $current eq 'ERR';
		if ($current eq 'Z1OFF') {
			$current = $self->getset('Z1', 'ON');
		}
		else {
			$current = $self->getset('Z1', 'OFF');
		}
		return $current if $current eq 'ERR';
                $current = substr($current, 2, 3);
	        $current = ($current eq 'OFF' ? 'ON' : 'OFF');
                return "MUTE $current";
	};
};

sub input
{
        my ($self, $value, $zone) = @_;
        $self->debugprint('INFO', "Denon Input $value\n");
        my $cmd = ( $zone == 1 ? 'Z1' : 'SI');
	return 'NOP' unless ((first {$_ eq $value} @inputs) || ($value eq ''));
	$cmd = $cmd.'INP' if ($cmd eq 'Z1' && $value eq '');
        $self->debugprint('INFO', "Denon Sending $value\n");
        my $result = $self->getset($cmd, $value);
	return $result if $result eq 'ERR';
        $result =~ s/SI/AMP_IN /;
        $result =~ s/Z1/AMP_IN /;
	return $result ;
};

sub get
{
	my ($self, $cmd) = @_;
	return $self->sendCommand("$cmd?");
};

sub set
{
	my ($self, $cmd, $value) = @_;
	return $self->sendCommand("$cmd$value");
};

sub getset
{
	my ($self, $cmd, $value) = @_;
	my $old = $self->get($cmd);
	return $old if $value eq '';
	my $new = $cmd.$value;
	return $old if $new eq $old;
	return $self->set($cmd, $value);
};


sub sendCommand
{
	my ($self, $cmd) = @_;
	foreach (1..3)
	{
		my $result = $self->sendCommand_inner($cmd);
                $self->debugprint('INFO', "Denon No Response\n") if $result eq 'NORESPONSE';
                next if $result eq 'NORESPONSE';
		$self->debugprint('INFO', "Command was \"$cmd\", response is \"$result\"\n");
		my $compare = substr($result, 0, 2);
		$self->debugprint('INFO', "Denon Bad Response\n") unless (($cmd =~ /($compare)/) || ($result =~ /PW/));
		next unless (($cmd =~ /($compare)/) || ($result =~ /PW/));

		#occasionally we get non-ascii characters mixed in with the data. If so, we need to reprompt
		if ($result =~ /([^a-zA-Z0-9_\- ])/)
		{
			$self->debugprint('ERROR', "Denon Received non ASCII character in response: '$1' Hex=".ord($1)."\n");
			redo;
		};
		$result =~ s/PW/$compare/;
		$result =~ s/STANDBY/OFF/;
		return $result;
	};
        $self->debugprint('INFO', "Denon Three Failed Send Attempts\n");
	return 'ERR';
};

sub sendCommand_inner
{
	my ($self, $cmd) = @_;
	$self->debugprint('INFO', "Denon\t\t$cmd\n");

	#clear the buffer
	while(1)
	{
		my ($bytes, $read) = $self->{port}->read(1);
		last if $bytes == 0;
		$self->debugprint('INFO', "Denon $bytes byte(s) -->$read<-- cleared from buffer\n");
	};

	if ($cmd =~ /Z1/ && $cmd =~ /\?/) {
		$self->{port}->write("Z1\?\r");
		my @results;
		my $which = 0 if $cmd =~ /INP/;
		$which = 1 if $cmd =~ /VOL/;
		$which = 2 if $cmd =~ /PWR/;
		$results[0] = $self->readOutput();
		$results[1] = $self->readOutput();
		$results[2] = $self->readOutput();
		return $results[$which];
	}
	else {
		$self->{port}->write("$cmd\r");
		return $self->readOutput();
	}
};

sub readOutput
{
	my ($self) = @_;
        my $data = '';
        my $start = Time::HiRes::time();
        while(1)
        {
                if ((Time::HiRes::time() - $start) >= 1)
                {
                        $self->debugprint("INFO", "Denon read timeout with partial data: -->$data<--\n") if ($data ne '');
                        $self->debugprint("INFO", "Denon read timeout with no data\n") if ($data eq '');
                        return 'NORESPONSE';
                };

                my ($bytes, $read) = $self->{port}->read(1);
                next if $bytes == 0;
                return $data if ($read eq "\r");
                $data .= $read;
        };
};

return 1;
